Bundestagswahl 2025

Data and visualisation of the 2025 federal parliamentary election results in Germany. Shapefile and election results from Bundeswahlleiterin: https://www.bundeswahlleiterin.de/bundestagswahlen/2025/ergebnisse/opendata/btw25/daten/

library(tidyverse)
library(tidygeocoder)
library(ggplot2)
library(sf)
library(rnaturalearth)
library(mapview)
library(dplyr)
library(spatstat)
library(leafpop)
library(readxl)

DE25<-st_read("btw25_geometrie_wahlkreise_vg250_shp_geo/btw25_geometrie_wahlkreise_vg250_shp_geo.shp")

Reading layer `btw25_geometrie_wahlkreise_vg250_shp_geo' from data source 
  `/Users/mz/Documents/webpages/michaelczeller.github.io/blog/2025/25/de_wahl2025/btw25_geometrie_wahlkreise_vg250_shp_geo/btw25_geometrie_wahlkreise_vg250_shp_geo.shp' 
  using driver `ESRI Shapefile'
Simple feature collection with 299 features and 4 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 5.86625 ymin: 47.27012 xmax: 15.04182 ymax: 55.05838
Geodetic CRS:  WGS 84

kerg <- read_delim("kerg2_00285.csv", delim = ";", 
                   escape_double = FALSE, trim_ws = TRUE, skip = 9)

kerg$Gebietsnummer <- as.numeric(kerg$Gebietsnummer)

kerg$Prozent        <- gsub(",", ".", kerg$Prozent)
kerg$VorpProzent    <- gsub(",", ".", kerg$VorpProzent)
kerg$DiffProzent    <- gsub(",", ".", kerg$DiffProzent)
kerg$DiffProzentPkt <- gsub(",", ".", kerg$DiffProzentPkt)

kerg$Prozent        <- as.numeric(kerg$Prozent)
kerg$VorpProzent    <- as.numeric(kerg$VorpProzent)
kerg$DiffProzent    <- as.numeric(kerg$DiffProzent)
kerg$DiffProzentPkt <- as.numeric(kerg$DiffProzentPkt)

Figure 1 shows the results of the five principal parties entering the Bundestag (i.e., excluding SSW).

Figure 1: Electoral results of the largest parties.

ggplot(zs1, aes(x=Gruppenname, y=DiffProzentPkt)) +
  geom_bar(stat="identity", colour="black", aes(fill=Gruppenname), legend=FALSE)+ 
  scale_fill_manual(values = c("AfD"="brown", # "#009EE0"
                               "CDU/CSU"="black",
                               "FDP"="#FFED00", # "gold",
                               "GRÜNE"="#64A12D",
                               "Die Linke"="#BE3075",
                               "SPD"="#EB001F")) +
  theme_void()+xlab("")+
  geom_text(aes(label = paste(round(DiffProzentPkt, 1), "%"),
                vjust = ifelse(DiffProzentPkt >= 0, 1.5, -0.5)), size=7)+
  geom_text(data=zs1 %>% filter(Gruppenname=="CDU/CSU"),
            aes(label = paste(round(DiffProzentPkt, 1), "%"),
                vjust = ifelse(DiffProzentPkt >= 0, 1.5, -0.5)), 
            color="grey", size=7)+
  theme(axis.text.x = element_text(angle = 45, vjust = 0.9, hjust=1, size=12),
        legend.position = "none")

Figure 2: Change in electoral results from 2021 results.

Figure 3 shows the areas of electoral strength for the parliamentary parties as well as the generally high election participation.

Figure 3: Maps of electoral performance of the five main parties entering the Bundestag.

Figure 4 shows the distribution of seats in the Bundestag following the election.

# https://stackoverflow.com/questions/42729174/creating-a-half-donut-or-parliamentary-seating-chart

library(ggforce)

parlDiag <- function(Parties, shares, cols = NULL, repr=c("absolute", "proportion")) {
  repr = match.arg(repr)
  stopifnot(length(Parties) == length(shares))
  if (repr == "proportion") {
    stopifnot(sum(shares) == 1)
  }
  if (!is.null(cols)) {
    names(cols) <- Parties
  }

  # arc start/end in rads, last one reset bc rounding errors
  cc <- cumsum(c(-pi/2, switch(repr, "absolute" = (shares / sum(shares)) * pi, "proportion" = shares * pi)))
  cc[length(cc)] <- pi/2

  # get angle of arc midpoints
  meanAngles <- colMeans(rbind(cc[2:length(cc)], cc[1:length(cc)-1]))

  # unit circle
  labelX <- sin(meanAngles)
  labelY <- cos(meanAngles)

  # prevent bounding box < y=0
  labelY <- ifelse(labelY < 0.015, 0.015, labelY)

  p <- ggplot() + theme_no_axes() + coord_fixed() +
    expand_limits(x = c(-1.3, 1.3), y = c(0, 1.3)) + 
    theme(panel.border = element_blank()) +
    theme(legend.position = "none") +

    geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = 0.5, r = 1,
                     start = cc[1:length(shares)], 
                     end = c(cc[2:length(shares)], pi/2), fill = Parties)) +

    switch(is.null(cols)+1, scale_fill_manual(values = cols), NULL) + 

    # for label and line positions, just scale sin & cos to get in and out of arc
    geom_path(aes(x = c(0.9 * labelX, 1.15 * labelX), y = c(0.9 * labelY, 1.15 * labelY),
                  group = rep(1:length(shares), 2)), colour = "white", size = 2) +
    geom_path(aes(x = c(0.9 * labelX, 1.15 * labelX), y = c(0.9 * labelY, 1.15 * labelY),
                  group = rep(1:length(shares), 2)), size = 1) +

    geom_label(aes(x = 1.15 * labelX, y = 1.15 * labelY, 
                   label = switch(repr,
                                  "absolute" = sprintf("%s\n%i", Parties, shares),
                                  "proportion" = sprintf("%s\n%i%%", Parties, round(shares*100)))), fontface = "bold", 
               label.padding = unit(1, "points")) +

    geom_point(aes(x = 0.9 * labelX, y = 0.9 * labelY), colour = "white", size = 2) +
    geom_point(aes(x = 0.9 * labelX, y = 0.9 * labelY)) +
    geom_text(aes(x = 0, y = 0, label = switch(repr, 
                                               "absolute" = (sprintf("Total: %i MPs", sum(shares))), 
                                               "proportion" = "")),
              fontface = "bold", size = 7) 

  return(p)
}

bt <- data.frame(parties = c("AfD", "CDU/CSU", "SPD", "Grüne", "Linke", "SSW"),
                 seats   = c(152,   208,       120,   85,      64,      1),
                 cols    = c("brown","black", "red", "green", "hotpink", "navy"),
                 colour  = c("brown","#000000","#EB001F","#64A12D","#BE3075","navy"), # "#009EE0"
                 stringsAsFactors = FALSE)

parlDiag(bt$parties, bt$seats, cols = bt$colour)

Figure 4: Bundestag seat distribution.

Figure 5 shows the distribution of seats in the Bundestag following the election.

# <https://stackoverflow.com/questions/28917150/parliamentary-seats-graph-colors-and-labels>

seats <- function(N,M, r0=2.5){ 
 radii <- seq(r0, 1, len=M)

 counts <- numeric(M)
 pts = do.call(rbind,
            lapply(1:M, function(i){
              counts[i] <<- round(N*radii[i]/sum(radii[i:M]))
              theta <- seq(0, pi, len = counts[i])
              N <<- N - counts[i]
              data.frame(x=radii[i]*cos(theta), y=radii[i]*sin(theta), r=i,
                         theta=theta)
            }  )
  )
   pts = pts[order(-pts$theta,-pts$r),]
   pts
 }


election <- function(seats, counts){
stopifnot(sum(counts)==nrow(seats))
seats$party = rep(1:length(counts),counts)
seats
}

layout = seats(630,16)
result = election(layout, bt$seats) 

# plot(result$x, result$y, 
#     col=c("brown","black", "red", "green", "hotpink", "navy")[result$party], #numeric index
#     pch=19, asp=1, 
#      frame.plot=FALSE, # gets rid of the surrounding rectangle
#     axes="F")   # gets rid of the numbers and ticks

## ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

## https://github.com/zmeers/ggparliament
library(ggparliament)

bt <- data.frame(parties = c("AfD", "CDU/CSU", "SPD", "Grüne", "Linke", "SSW"),
                 seats   = c(152,   208,       120,   85,      64,      1),
                 cols    = c("brown","black", "red", "green", "hotpink", "navy"),
                 colour  = c("#009EE0","#000000","#EB001F","#64A12D","#BE3075","navy"),
                 stringsAsFactors = FALSE)

germany <- parliament_data(election_data = bt, 
                           parl_rows = 10,
                           type = 'semicircle',
                           party_seats = bt$seats)

bundestag <- ggplot(germany, aes(x, y, colour = parties)) +
  geom_parliament_seats(size = 3) +
  labs(colour="Party") +  
  theme_ggparliament(legend = TRUE) +
  theme(legend.text=element_text(size=12),
        legend.title=element_blank(),
        legend.position = c(0.5, 0.25),
        # legend.position = "bottom",
        legend.background = element_rect(linetype = 1, linewidth = 0.5, colour = 1))+
  scale_colour_manual(values = germany$colour, 
                      limits = germany$parties) 

bundestag

Figure 5: Bundestag seat distribution.

Figure 6 shows the Wahlkreise and, by clicking on them, results for the most prominent parties.

## Zweitstimme
kerg_2 <- kerg %>% dplyr::filter(Stimme == 2 & Gebietsart == "Wahlkreis")

kerg_2 <- kerg_2 %>% dplyr::filter(Gruppenname == "AfD"|
                                     Gruppenname == "CDU"|
                                     Gruppenname == "CSU"|
                                     Gruppenname == "FDP"|
                                     Gruppenname == "Die Linke"|
                                     Gruppenname == "GRÜNE"|
                                     Gruppenname == "BSW"|
                                     Gruppenname == "SPD")

kerg_2_wide <- kerg_2 %>% 
  select(Gebietsnummer, Gebietsname, Gruppenname, Prozent) %>% 
  pivot_wider(names_from = "Gruppenname", values_from = "Prozent")

wkr_2 <- DE25 %>% left_join(kerg_2_wide, by = c("WKR_NR" = "Gebietsnummer"))

mapview(wkr_2, alpha.regions = 0.2, aplha = 1,
        label="Gebietsname", legend=F, layer.name='2025 BTW',
        map.types = c("CartoDB.Positron","CartoDB.DarkMatter"),
        popup = popupTable(kerg_2_wide,
                           zcol = c("Gebietsname",
                                    "AfD","CDU","CSU","SPD",
                                    "GRÜNE","Die Linke", "BSW","FDP")))

Figure 6: Map of Wahlkreise.

You can download the data by clicking the button below.

library(downloadthis)

kerg %>% download_this(
    output_name = "kerg2_00285",
    output_extension = ".csv",
    button_label = "Download dataset as csv",
    button_type = "warning",
    has_icon = TRUE,
    icon = "fa fa-save"
  )

DE25 %>% download_this(
    output_name = "DE25",
    output_extension = ".csv",
    button_label = "Download shapefile as csv",
    button_type = "warning",
    has_icon = TRUE,
    icon = "fa fa-save"
  )